home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / sencal.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  40KB  |  1,247 lines
  1. /* sencal.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  33.         sfactr;
  34.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  35.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  36. } status_;
  37.  
  38. #define status_1 status_
  39.  
  40. struct {
  41.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  42.         rstats[50];
  43.     integer iwidth, lwidth, nopage;
  44. } miscel_;
  45.  
  46. #define miscel_1 miscel_
  47.  
  48. struct {
  49.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  50.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  51. } flags_;
  52.  
  53. #define flags_1 flags_
  54.  
  55. struct {
  56.     doublereal tcstar[2], tcstop[2], tcincr[2];
  57.     integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
  58. } dc_;
  59.  
  60. #define dc_1 dc_
  61.  
  62. struct {
  63.     doublereal value[200000];
  64. } blank_;
  65.  
  66. #define blank_1 blank_
  67.  
  68. /* Table of constant values */
  69.  
  70. static integer c__0 = 0;
  71. static integer c__1 = 1;
  72. static integer c__7 = 7;
  73.  
  74. /*<       subroutine sencal >*/
  75. /* Subroutine */ int sencal_()
  76. {
  77.     /* Initialized data */
  78.  
  79.     static struct {
  80.     char e_1[8];
  81.     doublereal e_2;
  82.     } equiv_125 = { {'i', 's', 'e', ' ', ' ', ' ', ' ', ' '}, 0. };
  83.  
  84. #define alsise (*(doublereal *)&equiv_125)
  85.  
  86.     static struct {
  87.     char e_1[8];
  88.     doublereal e_2;
  89.     } equiv_126 = { {'b', 'r', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  90.  
  91. #define alsbr (*(doublereal *)&equiv_126)
  92.  
  93.     static struct {
  94.     char e_1[8];
  95.     doublereal e_2;
  96.     } equiv_127 = { {'i', 's', 'c', ' ', ' ', ' ', ' ', ' '}, 0. };
  97.  
  98. #define alsisc (*(doublereal *)&equiv_127)
  99.  
  100.     static struct {
  101.     char e_1[8];
  102.     doublereal e_2;
  103.     } equiv_128 = { {'n', 'e', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  104.  
  105. #define alsne (*(doublereal *)&equiv_128)
  106.  
  107.     static struct {
  108.     char e_1[8];
  109.     doublereal e_2;
  110.     } equiv_129 = { {'n', 'c', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  111.  
  112. #define alsnc (*(doublereal *)&equiv_129)
  113.  
  114.     static struct {
  115.     char e_1[8];
  116.     doublereal e_2;
  117.     } equiv_130 = { {'i', 'k', 'f', ' ', ' ', ' ', ' ', ' '}, 0. };
  118.  
  119. #define alsik (*(doublereal *)&equiv_130)
  120.  
  121.     static struct {
  122.     char e_1[8];
  123.     doublereal e_2;
  124.     } equiv_131 = { {'i', 'k', 'r', ' ', ' ', ' ', ' ', ' '}, 0. };
  125.  
  126. #define alsikr (*(doublereal *)&equiv_131)
  127.  
  128.     static struct {
  129.     char e_1[8];
  130.     doublereal e_2;
  131.     } equiv_132 = { {'v', 'a', 'f', ' ', ' ', ' ', ' ', ' '}, 0. };
  132.  
  133. #define alsva (*(doublereal *)&equiv_132)
  134.  
  135.     static struct {
  136.     char e_1[8];
  137.     doublereal e_2;
  138.     } equiv_133 = { {'j', 's', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  139.  
  140. #define alsjs (*(doublereal *)&equiv_133)
  141.  
  142.     static struct {
  143.     char e_1[32];
  144.     doublereal e_2;
  145.     } equiv_134 = { {'d', 'c', ' ', 's', 'e', 'n', 's', 'i', 't', 'i', 'v'
  146.         , 'i', 't', 'y', ' ', 'a', 'n', 'a', 'l', 'y', 's', 'i', 's', 
  147.         ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  148.  
  149. #define sentit ((doublereal *)&equiv_134)
  150.  
  151.     static struct {
  152.     char e_1[8];
  153.     doublereal e_2;
  154.     } equiv_135 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  155.  
  156. #define ablnk (*(doublereal *)&equiv_135)
  157.  
  158.     static struct {
  159.     char e_1[8];
  160.     doublereal e_2;
  161.     } equiv_136 = { {'r', 's', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  162.  
  163. #define alsrs (*(doublereal *)&equiv_136)
  164.  
  165.     static struct {
  166.     char e_1[8];
  167.     doublereal e_2;
  168.     } equiv_137 = { {'i', 's', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  169.  
  170. #define alsis (*(doublereal *)&equiv_137)
  171.  
  172.     static struct {
  173.     char e_1[8];
  174.     doublereal e_2;
  175.     } equiv_138 = { {'n', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  176.  
  177. #define alsn (*(doublereal *)&equiv_138)
  178.  
  179.     static struct {
  180.     char e_1[8];
  181.     doublereal e_2;
  182.     } equiv_139 = { {'r', 'b', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  183.  
  184. #define alsrb (*(doublereal *)&equiv_139)
  185.  
  186.     static struct {
  187.     char e_1[8];
  188.     doublereal e_2;
  189.     } equiv_140 = { {'r', 'c', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  190.  
  191. #define alsrc (*(doublereal *)&equiv_140)
  192.  
  193.     static struct {
  194.     char e_1[8];
  195.     doublereal e_2;
  196.     } equiv_141 = { {'r', 'e', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  197.  
  198. #define alsre (*(doublereal *)&equiv_141)
  199.  
  200.     static struct {
  201.     char e_1[8];
  202.     doublereal e_2;
  203.     } equiv_142 = { {'b', 'f', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  204.  
  205. #define alsbf (*(doublereal *)&equiv_142)
  206.  
  207.  
  208.     /* Format strings */
  209.     static char fmt_36[] = "(\0020dc sensitivities of output \002,5a8)";
  210.     static char fmt_41[] = "(\0020\002,8x,\002element\002,9x,\002element\002\
  211. ,7x,\002element\002,7x,\002normalized\002/10x,\002name\002,12x,\002value\002\
  212. ,6x,\002sensitivity    sensitivity\002/35x,\002 (volts/unit) (volts/percent\
  213. )\002/)";
  214.     static char fmt_42[] = "(\0020\002,8x,\002element\002,9x,\002element\002\
  215. ,7x,\002element\002,7x,\002normalized\002/10x,\002name\002,12x,\002value\002\
  216. ,6x,\002sensitivity    sensitivity\002/35x,\002  (amps/unit)  (amps/percent\
  217. )\002/)";
  218.     static char fmt_101[] = "(10x,a8,4x,1pd10.3,5x,d10.3,5x,d10.3)";
  219.     static char fmt_181[] = "(1x,a8)";
  220.     static char fmt_186[] = "(10x,a8,5x,\0020.\002,13x,\0020.\002,13x,\0020\
  221. .\002)";
  222.  
  223.     /* System generated locals */
  224.     integer i_1, i_2;
  225.  
  226.     /* Builtin functions */
  227.     integer s_wsfe(), do_fio(), e_wsfe();
  228.     double exp(), sqrt();
  229.  
  230.     /* Local variables */
  231.     static doublereal cbcn, cben, area, vabc, gben, vabe, vace, evbc, gbcn, 
  232.         evbe;
  233.     static integer locm;
  234.     static doublereal csat;
  235.     static integer locs;
  236.     extern /* Subroutine */ int asol_();
  237.     static integer ipos;
  238.     extern /* Subroutine */ int move_();
  239.     static integer locv;
  240.     static doublereal sens, type;
  241.     static integer loct;
  242.     static doublereal oikr;
  243.     static integer node1, node2, node3, node4, node5, node6;
  244.     extern /* Subroutine */ int zero8_();
  245.     static integer j, n, iptro;
  246.     extern /* Subroutine */ int title_();
  247.     static integer jstop;
  248.     static doublereal sensn;
  249.     static integer iptrv;
  250.     static doublereal evben, evbcn, q1, q2, sqarg, alsvb, bf, qb, br, va, vb;
  251.     extern /* Subroutine */ int dcdcmp_();
  252.     static doublereal xn;
  253. #define nodplc ((integer *)&blank_1)
  254. #define cvalue ((complex *)&blank_1)
  255.     static doublereal string[5];
  256.     static integer ioutyp, ivolts, noposo, nonego;
  257.     extern /* Subroutine */ int outnam_();
  258.     static integer loc;
  259.     static doublereal vbe, val, oik, ova, ovb;
  260.     static integer ise, isc;
  261.     static doublereal xne, xnc, vtc, vte, vbc, cbe, gbe, cbc, gbc, dqb, dq1, 
  262.         dq2;
  263.  
  264.     /* Fortran I/O blocks */
  265.     static cilist io__32 = { 0, 0, 0, fmt_36, 0 };
  266.     static cilist io__34 = { 0, 0, 0, fmt_41, 0 };
  267.     static cilist io__35 = { 0, 0, 0, fmt_42, 0 };
  268.     static cilist io__43 = { 0, 0, 0, fmt_101, 0 };
  269.     static cilist io__45 = { 0, 0, 0, fmt_101, 0 };
  270.     static cilist io__46 = { 0, 0, 0, fmt_101, 0 };
  271.     static cilist io__47 = { 0, 0, 0, fmt_181, 0 };
  272.     static cilist io__51 = { 0, 0, 0, fmt_186, 0 };
  273.     static cilist io__52 = { 0, 0, 0, fmt_101, 0 };
  274.     static cilist io__59 = { 0, 0, 0, fmt_101, 0 };
  275.     static cilist io__60 = { 0, 0, 0, fmt_101, 0 };
  276.     static cilist io__61 = { 0, 0, 0, fmt_181, 0 };
  277.     static cilist io__67 = { 0, 0, 0, fmt_186, 0 };
  278.     static cilist io__68 = { 0, 0, 0, fmt_101, 0 };
  279.     static cilist io__69 = { 0, 0, 0, fmt_186, 0 };
  280.     static cilist io__70 = { 0, 0, 0, fmt_101, 0 };
  281.     static cilist io__71 = { 0, 0, 0, fmt_186, 0 };
  282.     static cilist io__72 = { 0, 0, 0, fmt_101, 0 };
  283.     static cilist io__105 = { 0, 0, 0, fmt_101, 0 };
  284.     static cilist io__106 = { 0, 0, 0, fmt_186, 0 };
  285.     static cilist io__107 = { 0, 0, 0, fmt_101, 0 };
  286.     static cilist io__108 = { 0, 0, 0, fmt_101, 0 };
  287.     static cilist io__109 = { 0, 0, 0, fmt_186, 0 };
  288.     static cilist io__110 = { 0, 0, 0, fmt_101, 0 };
  289.     static cilist io__111 = { 0, 0, 0, fmt_101, 0 };
  290.     static cilist io__112 = { 0, 0, 0, fmt_101, 0 };
  291.     static cilist io__113 = { 0, 0, 0, fmt_101, 0 };
  292.     static cilist io__114 = { 0, 0, 0, fmt_186, 0 };
  293.     static cilist io__115 = { 0, 0, 0, fmt_101, 0 };
  294.     static cilist io__116 = { 0, 0, 0, fmt_186, 0 };
  295.     static cilist io__117 = { 0, 0, 0, fmt_101, 0 };
  296.     static cilist io__118 = { 0, 0, 0, fmt_186, 0 };
  297.     static cilist io__120 = { 0, 0, 0, fmt_101, 0 };
  298.     static cilist io__121 = { 0, 0, 0, fmt_186, 0 };
  299.     static cilist io__124 = { 0, 0, 0, fmt_101, 0 };
  300.  
  301.  
  302. /*<       implicit double precision (a-h,o-z) >*/
  303.  
  304. /*     this routine computes the dc sensitivities of circuit elements */
  305. /* with respect to user specified outputs. */
  306.  
  307. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  308. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  309. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  310. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  311. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  312. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  313. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  314. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  315. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  316. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  317. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  318. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  319. /* spice version 2g.6  sccsid=status 3/15/83 */
  320. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  321. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  322. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  323. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  324. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  325. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  326. /* spice version 2g.6  sccsid=flags 3/15/83 */
  327. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  328. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  329. /* spice version 2g.6  sccsid=dc 3/15/83 */
  330. /*<       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
  331. /*<      1   kinel,kidin,kovar,kidout >*/
  332. /* spice version 2g.6  sccsid=blank 3/15/83 */
  333. /*<       common /blank/ value(200000) >*/
  334. /*<       integer nodplc(64) >*/
  335. /*<       complex cvalue(32) >*/
  336. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  337.  
  338.  
  339. /*<       dimension string(5),sentit(4) >*/
  340. /*<       data alsrs,alsis,alsn,alsrb,alsrc,alsre / 2hrs,2his,1hn,2hrb,2hrc, >*/
  341. /*<      1   2hre / >*/
  342. /*<       data alsbf,alsise,alsbr,alsisc,alsne,alsnc,alsik,alsikr,alsva,alsv >*/
  343. /*<      1   / 2hbf,3hise,2hbr,3hisc,2hne,2hnc,3hikf,3hikr,3hvaf,3hvar/ >*/
  344. /*<       data alsjs /2hjs/ >*/
  345. /*<       data sentit / 8hdc sensi, 8htivity a, 8hnalysis , 8h         / >*/
  346. /*<       data ablnk / 1h  / >*/
  347.  
  348.  
  349. /*<       if (kinel.ne.0) go to 8 >*/
  350.     if (dc_1.kinel != 0) {
  351.     goto L8;
  352.     }
  353. /*<     4 call dcdcmp >*/
  354. /* L4: */
  355.     dcdcmp_();
  356.  
  357.  
  358. /*<     8 do 1000 n=1,nsens >*/
  359. L8:
  360.     i_1 = tabinf_1.nsens;
  361.     for (n = 1; n <= i_1; ++n) {
  362.  
  363. /*  prepare adjoint excitation vector */
  364.  
  365. /*<       call zero8(value(lvn+1),nstop) >*/
  366.     zero8_(&blank_1.value[tabinf_1.lvn], &cirdat_1.nstop);
  367. /*<       locs=nodplc(isens+n) >*/
  368.     locs = nodplc[tabinf_1.isens + n - 1];
  369. /*<       ioutyp=nodplc(locs+5) >*/
  370.     ioutyp = nodplc[locs + 4];
  371. /*<       if (ioutyp.ne.0) go to 10 >*/
  372.     if (ioutyp != 0) {
  373.         goto L10;
  374.     }
  375. /* ...  voltage output */
  376. /*<       ivolts=1 >*/
  377.     ivolts = 1;
  378. /*<       noposo=nodplc(locs+2) >*/
  379.     noposo = nodplc[locs + 1];
  380. /*<       nonego=nodplc(locs+3) >*/
  381.     nonego = nodplc[locs + 2];
  382. /*<       value(lvn+noposo)=-1.0d0 >*/
  383.     blank_1.value[tabinf_1.lvn + noposo - 1] = -1.;
  384. /*<       value(lvn+nonego)=+1.0d0 >*/
  385.     blank_1.value[tabinf_1.lvn + nonego - 1] = 1.;
  386. /*<       go to 20 >*/
  387.     goto L20;
  388. /* ...  current output (through voltage source) */
  389. /*<    10 iptro=nodplc(locs+2) >*/
  390. L10:
  391.     iptro = nodplc[locs + 1];
  392. /*<       ivolts=0 >*/
  393.     ivolts = 0;
  394. /*<       iptro=nodplc(iptro+6) >*/
  395.     iptro = nodplc[iptro + 5];
  396. /*<       value(lvn+iptro)=-1.0d0 >*/
  397.     blank_1.value[tabinf_1.lvn + iptro - 1] = -1.;
  398.  
  399. /*  obtain adjoint solution by doing forward/backward substitution on 
  400. */
  401. /*  the transpose of the y matrix */
  402.  
  403. /*<    20 call asol >*/
  404. L20:
  405.     asol_();
  406. /*<       value(lvn+1)=0.0d0 >*/
  407.     blank_1.value[tabinf_1.lvn] = 0.;
  408.  
  409. /*  real solution in lvnim1;  adjoint solution in lvn ... */
  410.  
  411. /*<       call title(0,lwidth,1,sentit) >*/
  412.     title_(&c__0, &miscel_1.lwidth, &c__1, sentit);
  413. /*<       ipos=1 >*/
  414.     ipos = 1;
  415. /*<       call outnam(locs,1,string,ipos) >*/
  416.     outnam_(&locs, &c__1, string, &ipos);
  417. /*<       call move(string,ipos,ablnk,1,7) >*/
  418.     move_(string, &ipos, &ablnk, &c__1, &c__7);
  419. /*<       jstop=(ipos+6)/8 >*/
  420.     jstop = (ipos + 6) / 8;
  421. /*<       write (iofile,36) (string(j),j=1,jstop) >*/
  422.     io__32.ciunit = status_1.iofile;
  423.     s_wsfe(&io__32);
  424.     i_2 = jstop;
  425.     for (j = 1; j <= i_2; ++j) {
  426.         do_fio(&c__1, (char *)&string[j - 1], (ftnlen)sizeof(doublereal));
  427.  
  428.     }
  429.     e_wsfe();
  430. /*<    36 format('0dc sensitivities of output ',5a8) >*/
  431. /*<       if(ivolts.ne.0) write (iofile,41) >*/
  432.     if (ivolts != 0) {
  433.         io__34.ciunit = status_1.iofile;
  434.         s_wsfe(&io__34);
  435.         e_wsfe();
  436.     }
  437. /*<       if(ivolts.eq.0) write(iofile,42) >*/
  438.     if (ivolts == 0) {
  439.         io__35.ciunit = status_1.iofile;
  440.         s_wsfe(&io__35);
  441.         e_wsfe();
  442.     }
  443. /*<    41 format(1h0,8x,'element',9x,'element',7x,'element',7x,'normalized'/ >*/
  444. /*<      1   10x,'name',12x,'value',6x,'sensitivity    sensitivity'/35x, >*/
  445. /*<      2   ' (volts/unit) (volts/percent)'/) >*/
  446. /*<    42 format(1h0,8x,'element',9x,'element',7x,'element',7x,'normalized'/ >*/
  447. /*<      1   10x,'name',12x,'value',6x,'sensitivity    sensitivity'/35x, >*/
  448. /*<      2   '  (amps/unit)  (amps/percent)'/) >*/
  449.  
  450. /*  resistors */
  451.  
  452. /*<       loc=locate(1) >*/
  453.     loc = cirdat_1.locate[0];
  454. /*<   100 if ((loc.eq.0).or.(nodplc(loc+8).ne.0)) go to 110 >*/
  455. L100:
  456.     if (loc == 0 || nodplc[loc + 7] != 0) {
  457.         goto L110;
  458.     }
  459. /*<       locv=nodplc(loc+1) >*/
  460.     locv = nodplc[loc];
  461. /*<       node1=nodplc(loc+2) >*/
  462.     node1 = nodplc[loc + 1];
  463. /*<       node2=nodplc(loc+3) >*/
  464.     node2 = nodplc[loc + 2];
  465. /*<       val=1.0d0/value(locv+1) >*/
  466.     val = 1. / blank_1.value[locv];
  467. /*<       sens=-(value(lvnim1+node1)-value(lvnim1+node2))* >*/
  468. /*<      1      (value(lvn   +node1)-value(lvn   +node2))/(val*val) >*/
  469.     sens = -(blank_1.value[tabinf_1.lvnim1 + node1 - 1] - blank_1.value[
  470.         tabinf_1.lvnim1 + node2 - 1]) * (blank_1.value[tabinf_1.lvn + 
  471.         node1 - 1] - blank_1.value[tabinf_1.lvn + node2 - 1]) / (val *
  472.          val);
  473. /*<       sensn=val*sens/100.0d0 >*/
  474.     sensn = val * sens / 100.;
  475. /*<       write (iofile,101) value(locv),val,sens,sensn >*/
  476.     io__43.ciunit = status_1.iofile;
  477.     s_wsfe(&io__43);
  478.     do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
  479.         doublereal));
  480.     do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal));
  481.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  482.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  483.     e_wsfe();
  484. /*<   101 format(10x,a8,4x,1pd10.3,5x,d10.3,5x,d10.3) >*/
  485. /*<   105 loc=nodplc(loc) >*/
  486. /* L105: */
  487.     loc = nodplc[loc - 1];
  488. /*<       go to 100 >*/
  489.     goto L100;
  490.  
  491. /*  voltage sources */
  492.  
  493. /*<   110 loc=locate(9) >*/
  494. L110:
  495.     loc = cirdat_1.locate[8];
  496. /*<   140 if ((loc.eq.0).or.(nodplc(loc+11).ne.0)) go to 150 >*/
  497. L140:
  498.     if (loc == 0 || nodplc[loc + 10] != 0) {
  499.         goto L150;
  500.     }
  501. /*<       locv=nodplc(loc+1) >*/
  502.     locv = nodplc[loc];
  503. /*<       val=value(locv+1) >*/
  504.     val = blank_1.value[locv];
  505. /*<       iptrv=nodplc(loc+6) >*/
  506.     iptrv = nodplc[loc + 5];
  507. /*<       sens=-value(lvn+iptrv) >*/
  508.     sens = -blank_1.value[tabinf_1.lvn + iptrv - 1];
  509. /*<       sensn=val*sens/100.0d0 >*/
  510.     sensn = val * sens / 100.;
  511. /*<       write (iofile,101) value(locv),val,sens,sensn >*/
  512.     io__45.ciunit = status_1.iofile;
  513.     s_wsfe(&io__45);
  514.     do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
  515.         doublereal));
  516.     do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal));
  517.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  518.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  519.     e_wsfe();
  520. /*<   145 loc=nodplc(loc) >*/
  521. /* L145: */
  522.     loc = nodplc[loc - 1];
  523. /*<       go to 140 >*/
  524.     goto L140;
  525.  
  526. /*  current sources */
  527.  
  528. /*<   150 loc=locate(10) >*/
  529. L150:
  530.     loc = cirdat_1.locate[9];
  531. /*<   160 if ((loc.eq.0).or.(nodplc(loc+6).ne.0)) go to 170 >*/
  532. L160:
  533.     if (loc == 0 || nodplc[loc + 5] != 0) {
  534.         goto L170;
  535.     }
  536. /*<       locv=nodplc(loc+1) >*/
  537.     locv = nodplc[loc];
  538. /*<       node1=nodplc(loc+2) >*/
  539.     node1 = nodplc[loc + 1];
  540. /*<       node2=nodplc(loc+3) >*/
  541.     node2 = nodplc[loc + 2];
  542. /*<       val=value(locv+1) >*/
  543.     val = blank_1.value[locv];
  544. /*<       sens=value(lvn+node1)-value(lvn+node2) >*/
  545.     sens = blank_1.value[tabinf_1.lvn + node1 - 1] - blank_1.value[
  546.         tabinf_1.lvn + node2 - 1];
  547. /*<       sensn=val*sens/100.0d0 >*/
  548.     sensn = val * sens / 100.;
  549. /*<       write (iofile,101) value(locv),val,sens,sensn >*/
  550.     io__46.ciunit = status_1.iofile;
  551.     s_wsfe(&io__46);
  552.     do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
  553.         doublereal));
  554.     do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal));
  555.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  556.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  557.     e_wsfe();
  558. /*<   165 loc=nodplc(loc) >*/
  559. /* L165: */
  560.     loc = nodplc[loc - 1];
  561. /*<       go to 160 >*/
  562.     goto L160;
  563.  
  564. /*  diodes */
  565.  
  566. /*<   170 loc=locate(11) >*/
  567. L170:
  568.     loc = cirdat_1.locate[10];
  569. /*<   180 if ((loc.eq.0).or.(nodplc(loc+16).ne.0)) go to 210 >*/
  570. L180:
  571.     if (loc == 0 || nodplc[loc + 15] != 0) {
  572.         goto L210;
  573.     }
  574. /*<       locv=nodplc(loc+1) >*/
  575.     locv = nodplc[loc];
  576. /*<       write (iofile,181) value(locv) >*/
  577.     io__47.ciunit = status_1.iofile;
  578.     s_wsfe(&io__47);
  579.     do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
  580.         doublereal));
  581.     e_wsfe();
  582. /*<   181 format(1x,a8) >*/
  583. /*<       node1=nodplc(loc+2) >*/
  584.     node1 = nodplc[loc + 1];
  585. /*<       node2=nodplc(loc+3) >*/
  586.     node2 = nodplc[loc + 2];
  587. /*<       node3=nodplc(loc+4) >*/
  588.     node3 = nodplc[loc + 3];
  589. /*<       locm=nodplc(loc+5) >*/
  590.     locm = nodplc[loc + 4];
  591. /*<       locm=nodplc(locm+1) >*/
  592.     locm = nodplc[locm];
  593. /*<       area=value(locv+1) >*/
  594.     area = blank_1.value[locv];
  595.  
  596. /*  series resistance (rs) */
  597.  
  598. /*<       val=value(locm+2)*area >*/
  599.     val = blank_1.value[locm + 1] * area;
  600. /*<       if (val.ne.0.0d0) go to 190 >*/
  601.     if (val != 0.) {
  602.         goto L190;
  603.     }
  604. /*<       write (iofile,186) alsrs >*/
  605.     io__51.ciunit = status_1.iofile;
  606.     s_wsfe(&io__51);
  607.     do_fio(&c__1, (char *)&alsrs, (ftnlen)sizeof(doublereal));
  608.     e_wsfe();
  609. /*<   186 format(10x,a8,5x,2h0.,13x,2h0.,13x,2h0.) >*/
  610. /*<       go to 200 >*/
  611.     goto L200;
  612. /*<   190 val=1.0d0/val >*/
  613. L190:
  614.     val = 1. / val;
  615. /*<       sens=-(value(lvnim1+node1)-value(lvnim1+node3))* >*/
  616. /*<      1      (value(lvn   +node1)-value(lvn   +node3))/(val*val) >*/
  617.     sens = -(blank_1.value[tabinf_1.lvnim1 + node1 - 1] - blank_1.value[
  618.         tabinf_1.lvnim1 + node3 - 1]) * (blank_1.value[tabinf_1.lvn + 
  619.         node1 - 1] - blank_1.value[tabinf_1.lvn + node3 - 1]) / (val *
  620.          val);
  621. /*<       sensn=val*sens/100.0d0 >*/
  622.     sensn = val * sens / 100.;
  623. /*<       write (iofile,101) alsrs,val,sens,sensn >*/
  624.     io__52.ciunit = status_1.iofile;
  625.     s_wsfe(&io__52);
  626.     do_fio(&c__1, (char *)&alsrs, (ftnlen)sizeof(doublereal));
  627.     do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal));
  628.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  629.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  630.     e_wsfe();
  631.  
  632. /*  intrinsic parameters */
  633.  
  634. /*<   200 csat=value(locm+1)*area >*/
  635. L200:
  636.     csat = blank_1.value[locm] * area;
  637. /*<       xn=value(locm+3) >*/
  638.     xn = blank_1.value[locm + 2];
  639. /*<       vbe=value(lvnim1+node3)-value(lvnim1+node2) >*/
  640.     vbe = blank_1.value[tabinf_1.lvnim1 + node3 - 1] - blank_1.value[
  641.         tabinf_1.lvnim1 + node2 - 1];
  642. /*<       vte=xn*vt >*/
  643.     vte = xn * status_1.vt;
  644. /*<       evbe=dexp(vbe/vte) >*/
  645.     evbe = exp(vbe / vte);
  646. /*<       vabe=value(lvn+node3)-value(lvn+node2) >*/
  647.     vabe = blank_1.value[tabinf_1.lvn + node3 - 1] - blank_1.value[
  648.         tabinf_1.lvn + node2 - 1];
  649.  
  650. /*  saturation current (is) */
  651.  
  652. /*<       sens=vabe*(evbe-1.0d0) >*/
  653.     sens = vabe * (evbe - 1.);
  654. /*<       sensn=csat*sens/100.0d0 >*/
  655.     sensn = csat * sens / 100.;
  656. /*<       write (iofile,101) alsis,csat,sens,sensn >*/
  657.     io__59.ciunit = status_1.iofile;
  658.     s_wsfe(&io__59);
  659.     do_fio(&c__1, (char *)&alsis, (ftnlen)sizeof(doublereal));
  660.     do_fio(&c__1, (char *)&csat, (ftnlen)sizeof(doublereal));
  661.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  662.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  663.     e_wsfe();
  664.  
  665. /*  ideality factor (n) */
  666.  
  667. /*<       sens=-vabe*(csat/xn)*(vbe/vte)*evbe >*/
  668.     sens = -vabe * (csat / xn) * (vbe / vte) * evbe;
  669. /*<       if (dabs(sens).lt.1.0d-30) sens=0.0d0 >*/
  670.     if (abs(sens) < 1e-30) {
  671.         sens = 0.;
  672.     }
  673. /*<       sensn=xn*sens/100.0d0 >*/
  674.     sensn = xn * sens / 100.;
  675. /*<       write (iofile,101) alsn,xn,sens,sensn >*/
  676.     io__60.ciunit = status_1.iofile;
  677.     s_wsfe(&io__60);
  678.     do_fio(&c__1, (char *)&alsn, (ftnlen)sizeof(doublereal));
  679.     do_fio(&c__1, (char *)&xn, (ftnlen)sizeof(doublereal));
  680.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  681.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  682.     e_wsfe();
  683. /*<   205 loc=nodplc(loc) >*/
  684. /* L205: */
  685.     loc = nodplc[loc - 1];
  686. /*<       go to 180 >*/
  687.     goto L180;
  688.  
  689. /*  bipolar junction transistors */
  690.  
  691. /*<   210 loc=locate(12) >*/
  692. L210:
  693.     loc = cirdat_1.locate[11];
  694. /*<   220 if ((loc.eq.0).or.(nodplc(loc+36).ne.0)) go to 1000 >*/
  695. L220:
  696.     if (loc == 0 || nodplc[loc + 35] != 0) {
  697.         goto L1000;
  698.     }
  699. /*<       locv=nodplc(loc+1) >*/
  700.     locv = nodplc[loc];
  701. /*<       write (iofile,181) value(locv) >*/
  702.     io__61.ciunit = status_1.iofile;
  703.     s_wsfe(&io__61);
  704.     do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
  705.         doublereal));
  706.     e_wsfe();
  707. /*<       node1=nodplc(loc+2) >*/
  708.     node1 = nodplc[loc + 1];
  709. /*<       node2=nodplc(loc+3) >*/
  710.     node2 = nodplc[loc + 2];
  711. /*<       node3=nodplc(loc+4) >*/
  712.     node3 = nodplc[loc + 3];
  713. /*<       node4=nodplc(loc+5) >*/
  714.     node4 = nodplc[loc + 4];
  715. /*<       node5=nodplc(loc+6) >*/
  716.     node5 = nodplc[loc + 5];
  717. /*<       node6=nodplc(loc+7) >*/
  718.     node6 = nodplc[loc + 6];
  719. /*<       locm=nodplc(loc+8) >*/
  720.     locm = nodplc[loc + 7];
  721. /*<       type=nodplc(locm+2) >*/
  722.     type = (doublereal) nodplc[locm + 1];
  723. /*<       locm=nodplc(locm+1) >*/
  724.     locm = nodplc[locm];
  725. /*<       loct=lx0+nodplc(loc+22) >*/
  726.     loct = tabinf_1.lx0 + nodplc[loc + 21];
  727. /*<       area=value(locv+1) >*/
  728.     area = blank_1.value[locv];
  729.  
  730. /*  base resistance (rb) */
  731.  
  732. /*<       val=value(loct+16) >*/
  733.     val = blank_1.value[loct + 15];
  734. /*<       if (val.ne.0.0d0) go to 230 >*/
  735.     if (val != 0.) {
  736.         goto L230;
  737.     }
  738. /*<       write (iofile,186) alsrb >*/
  739.     io__67.ciunit = status_1.iofile;
  740.     s_wsfe(&io__67);
  741.     do_fio(&c__1, (char *)&alsrb, (ftnlen)sizeof(doublereal));
  742.     e_wsfe();
  743. /*<       go to 240 >*/
  744.     goto L240;
  745. /*<   230 val=1.0d0/val >*/
  746. L230:
  747.     val = 1. / val;
  748. /*<       sens=-(value(lvnim1+node2)-value(lvnim1+node5))* >*/
  749. /*<      1      (value(lvn   +node2)-value(lvn   +node5))/(val*val) >*/
  750.     sens = -(blank_1.value[tabinf_1.lvnim1 + node2 - 1] - blank_1.value[
  751.         tabinf_1.lvnim1 + node5 - 1]) * (blank_1.value[tabinf_1.lvn + 
  752.         node2 - 1] - blank_1.value[tabinf_1.lvn + node5 - 1]) / (val *
  753.          val);
  754. /*<       sensn=val*sens/100.0d0 >*/
  755.     sensn = val * sens / 100.;
  756. /*<       write (iofile,101) alsrb,val,sens,sensn >*/
  757.     io__68.ciunit = status_1.iofile;
  758.     s_wsfe(&io__68);
  759.     do_fio(&c__1, (char *)&alsrb, (ftnlen)sizeof(doublereal));
  760.     do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal));
  761.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  762.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  763.     e_wsfe();
  764.  
  765. /*  collector resistance (rc) */
  766.  
  767. /*<   240 val=value(locm+20)*area >*/
  768. L240:
  769.     val = blank_1.value[locm + 19] * area;
  770. /*<       if (val.ne.0.0d0) go to 250 >*/
  771.     if (val != 0.) {
  772.         goto L250;
  773.     }
  774. /*<       write (iofile,186) alsrc >*/
  775.     io__69.ciunit = status_1.iofile;
  776.     s_wsfe(&io__69);
  777.     do_fio(&c__1, (char *)&alsrc, (ftnlen)sizeof(doublereal));
  778.     e_wsfe();
  779. /*<       go to 260 >*/
  780.     goto L260;
  781. /*<   250 val=1.0d0/val >*/
  782. L250:
  783.     val = 1. / val;
  784. /*<       sens=-(value(lvnim1+node1)-value(lvnim1+node4))* >*/
  785. /*<      1      (value(lvn   +node1)-value(lvn   +node4))/(val*val) >*/
  786.     sens = -(blank_1.value[tabinf_1.lvnim1 + node1 - 1] - blank_1.value[
  787.         tabinf_1.lvnim1 + node4 - 1]) * (blank_1.value[tabinf_1.lvn + 
  788.         node1 - 1] - blank_1.value[tabinf_1.lvn + node4 - 1]) / (val *
  789.          val);
  790. /*<       sensn=val*sens/100.0d0 >*/
  791.     sensn = val * sens / 100.;
  792. /*<       write (iofile,101) alsrc,val,sens,sensn >*/
  793.     io__70.ciunit = status_1.iofile;
  794.     s_wsfe(&io__70);
  795.     do_fio(&c__1, (char *)&alsrc, (ftnlen)sizeof(doublereal));
  796.     do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal));
  797.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  798.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  799.     e_wsfe();
  800.  
  801. /*  emitter resistance (re) */
  802.  
  803. /*<   260 val=value(locm+19)*area >*/
  804. L260:
  805.     val = blank_1.value[locm + 18] * area;
  806. /*<       if (val.ne.0.0d0) go to 270 >*/
  807.     if (val != 0.) {
  808.         goto L270;
  809.     }
  810. /*<       write (iofile,186) alsre >*/
  811.     io__71.ciunit = status_1.iofile;
  812.     s_wsfe(&io__71);
  813.     do_fio(&c__1, (char *)&alsre, (ftnlen)sizeof(doublereal));
  814.     e_wsfe();
  815. /*<       go to 280 >*/
  816.     goto L280;
  817. /*<   270 val=1.0d0/val >*/
  818. L270:
  819.     val = 1. / val;
  820. /*<       sens=-(value(lvnim1+node3)-value(lvnim1+node6))* >*/
  821. /*<      1      (value(lvn   +node3)-value(lvn   +node6))/(val*val) >*/
  822.     sens = -(blank_1.value[tabinf_1.lvnim1 + node3 - 1] - blank_1.value[
  823.         tabinf_1.lvnim1 + node6 - 1]) * (blank_1.value[tabinf_1.lvn + 
  824.         node3 - 1] - blank_1.value[tabinf_1.lvn + node6 - 1]) / (val *
  825.          val);
  826. /*<       sensn=val*sens/100.0d0 >*/
  827.     sensn = val * sens / 100.;
  828. /*<       write (iofile,101) alsre,val,sens,sensn >*/
  829.     io__72.ciunit = status_1.iofile;
  830.     s_wsfe(&io__72);
  831.     do_fio(&c__1, (char *)&alsre, (ftnlen)sizeof(doublereal));
  832.     do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal));
  833.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  834.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  835.     e_wsfe();
  836.  
  837. /*  intrinsic parameters */
  838.  
  839. /*<   280 bf=value(locm+2) >*/
  840. L280:
  841.     bf = blank_1.value[locm + 1];
  842. /*<       br=value(locm+8) >*/
  843.     br = blank_1.value[locm + 7];
  844. /*<       csat=value(locm+1)*area >*/
  845.     csat = blank_1.value[locm] * area;
  846. /*<       ova=value(locm+4) >*/
  847.     ova = blank_1.value[locm + 3];
  848. /*<       ovb=value(locm+10) >*/
  849.     ovb = blank_1.value[locm + 9];
  850. /*<       oik=value(locm+5)/area >*/
  851.     oik = blank_1.value[locm + 4] / area;
  852. /*<       ise=value(locm+6)*area >*/
  853.     ise = (integer) (blank_1.value[locm + 5] * area);
  854. /*<       xne=value(locm+7) >*/
  855.     xne = blank_1.value[locm + 6];
  856. /*<       vte=xne*vt >*/
  857.     vte = xne * status_1.vt;
  858. /*<       oikr=value(locm+11)/area >*/
  859.     oikr = blank_1.value[locm + 10] / area;
  860. /*<       isc=value(locm+12)*area >*/
  861.     isc = (integer) (blank_1.value[locm + 11] * area);
  862. /*<       xnc=value(locm+13) >*/
  863.     xnc = blank_1.value[locm + 12];
  864. /*<       vtc=xnc*vt >*/
  865.     vtc = xnc * status_1.vt;
  866. /*<       vbe=type*(value(lvnim1+node5)-value(lvnim1+node6)) >*/
  867.     vbe = type * (blank_1.value[tabinf_1.lvnim1 + node5 - 1] - 
  868.         blank_1.value[tabinf_1.lvnim1 + node6 - 1]);
  869. /*<       vbc=type*(value(lvnim1+node5)-value(lvnim1+node4)) >*/
  870.     vbc = type * (blank_1.value[tabinf_1.lvnim1 + node5 - 1] - 
  871.         blank_1.value[tabinf_1.lvnim1 + node4 - 1]);
  872. /*<       vabe=type*(value(lvn+node5)-value(lvn+node6)) >*/
  873.     vabe = type * (blank_1.value[tabinf_1.lvn + node5 - 1] - 
  874.         blank_1.value[tabinf_1.lvn + node6 - 1]);
  875. /*<       vabc=type*(value(lvn+node5)-value(lvn+node4)) >*/
  876.     vabc = type * (blank_1.value[tabinf_1.lvn + node5 - 1] - 
  877.         blank_1.value[tabinf_1.lvn + node4 - 1]);
  878. /*<       vace=vabe-vabc >*/
  879.     vace = vabe - vabc;
  880. /*<       if (vbe.le.-vt) go to 320 >*/
  881.     if (vbe <= -status_1.vt) {
  882.         goto L320;
  883.     }
  884. /*<       evbe=dexp(vbe/vt/value(locm+3)) >*/
  885.     evbe = exp(vbe / status_1.vt / blank_1.value[locm + 2]);
  886. /*<       cbe=csat*(evbe-1.0d0) >*/
  887.     cbe = csat * (evbe - 1.);
  888. /*<       gbe=csat*evbe/vt/value(locm+3) >*/
  889.     gbe = csat * evbe / status_1.vt / blank_1.value[locm + 2];
  890. /*<       if (ise.ne.0.0d0) go to 310 >*/
  891.     if ((doublereal) ise != 0.) {
  892.         goto L310;
  893.     }
  894. /*<       cben=0.0d0 >*/
  895.     cben = 0.;
  896. /*<       gben=0.0d0 >*/
  897.     gben = 0.;
  898. /*<       go to 350 >*/
  899.     goto L350;
  900. /*<   310 evben=dexp(vbe/vte) >*/
  901. L310:
  902.     evben = exp(vbe / vte);
  903. /*<       cben=ise     *(evben-1.0d0) >*/
  904.     cben = ise * (evben - 1.);
  905. /*<       gben=ise     *evben/vte >*/
  906.     gben = ise * evben / vte;
  907. /*<       go to 350 >*/
  908.     goto L350;
  909. /*<   320 gbe=-csat/vbe >*/
  910. L320:
  911.     gbe = -csat / vbe;
  912. /*<       cbe=gbe*vbe >*/
  913.     cbe = gbe * vbe;
  914. /*<       gben=-ise/vbe >*/
  915.     gben = -ise / vbe;
  916. /*<       cben=gben*vbe >*/
  917.     cben = gben * vbe;
  918. /*<   350 if (vbc.le.-vt) go to 370 >*/
  919. L350:
  920.     if (vbc <= -status_1.vt) {
  921.         goto L370;
  922.     }
  923. /*<       evbc=dexp(vbc/vt/value(locm+9)) >*/
  924.     evbc = exp(vbc / status_1.vt / blank_1.value[locm + 8]);
  925. /*<       cbc=csat*(evbc-1.0d0) >*/
  926.     cbc = csat * (evbc - 1.);
  927. /*<       gbc=csat*evbc/vt/value(locm+9) >*/
  928.     gbc = csat * evbc / status_1.vt / blank_1.value[locm + 8];
  929. /*<       if (isc.ne.0.0d0) go to 360 >*/
  930.     if ((doublereal) isc != 0.) {
  931.         goto L360;
  932.     }
  933. /*<       cbcn=0.0d0 >*/
  934.     cbcn = 0.;
  935. /*<       gbcn=0.0d0 >*/
  936.     gbcn = 0.;
  937. /*<       go to 400 >*/
  938.     goto L400;
  939. /*<   360 evbcn=dexp(vbc/vtc) >*/
  940. L360:
  941.     evbcn = exp(vbc / vtc);
  942. /*<       cbcn=isc     *(evbcn-1.0d0) >*/
  943.     cbcn = isc * (evbcn - 1.);
  944. /*<       gbcn=isc     *evbcn/vtc >*/
  945.     gbcn = isc * evbcn / vtc;
  946. /*<       go to 400 >*/
  947.     goto L400;
  948. /*<   370 gbc=-csat/vbc >*/
  949. L370:
  950.     gbc = -csat / vbc;
  951. /*<       cbc=gbc*vbc >*/
  952.     cbc = gbc * vbc;
  953. /*<       gbcn=-isc/vbc >*/
  954.     gbcn = -isc / vbc;
  955. /*<       cbcn=gbcn*vbc >*/
  956.     cbcn = gbcn * vbc;
  957. /*<   400 q1=1.0d0/(1.0d0-ova*vbc-ovb*vbe) >*/
  958. L400:
  959.     q1 = 1. / (1. - ova * vbc - ovb * vbe);
  960. /*<       q2=oik*cbe+oikr*cbc >*/
  961.     q2 = oik * cbe + oikr * cbc;
  962. /*<       sqarg=dsqrt(1.0d0+4.0d0*q2) >*/
  963.     sqarg = sqrt(q2 * 4. + 1.);
  964. /*<       qb=q1*(1.0d0+sqarg)/2.0d0 >*/
  965.     qb = q1 * (sqarg + 1.) / 2.;
  966. /*<       dqb=(cbe-cbc)/(qb*qb) >*/
  967.     dqb = (cbe - cbc) / (qb * qb);
  968. /*<       sqarg=dsqrt(1.0d0+4.0d0*q2) >*/
  969.     sqarg = sqrt(q2 * 4. + 1.);
  970. /*<       dq1=dqb*(1.0d0+sqarg)/2.0d0 >*/
  971.     dq1 = dqb * (sqarg + 1.) / 2.;
  972. /*<       dq2=q1*dqb/sqarg >*/
  973.     dq2 = q1 * dqb / sqarg;
  974.  
  975. /*  compute sensitivities */
  976.  
  977. /* ...  bf */
  978. /*<       sens=-vabe*cbe/bf/bf >*/
  979.     sens = -vabe * cbe / bf / bf;
  980. /*<       sensn=bf*sens/100.0d0 >*/
  981.     sensn = bf * sens / 100.;
  982. /*<       write (iofile,101) alsbf,bf,sens,sensn >*/
  983.     io__105.ciunit = status_1.iofile;
  984.     s_wsfe(&io__105);
  985.     do_fio(&c__1, (char *)&alsbf, (ftnlen)sizeof(doublereal));
  986.     do_fio(&c__1, (char *)&bf, (ftnlen)sizeof(doublereal));
  987.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  988.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  989.     e_wsfe();
  990. /* ...  ise */
  991. /*<       if (ise.ne.0.0d0) go to 430 >*/
  992.     if ((doublereal) ise != 0.) {
  993.         goto L430;
  994.     }
  995. /*<       write (iofile,186) alsise >*/
  996.     io__106.ciunit = status_1.iofile;
  997.     s_wsfe(&io__106);
  998.     do_fio(&c__1, (char *)&alsise, (ftnlen)sizeof(doublereal));
  999.     e_wsfe();
  1000. /*<       go to 440 >*/
  1001.     goto L440;
  1002. /*<   430 sens=vabe*cben/ise >*/
  1003. L430:
  1004.     sens = vabe * cben / ise;
  1005. /*<       sensn=ise*sens/100.0d0 >*/
  1006.     sensn = ise * sens / 100.;
  1007. /*<       write (iofile,101) alsise,ise,sens,sensn >*/
  1008.     io__107.ciunit = status_1.iofile;
  1009.     s_wsfe(&io__107);
  1010.     do_fio(&c__1, (char *)&alsise, (ftnlen)sizeof(doublereal));
  1011.     do_fio(&c__1, (char *)&ise, (ftnlen)sizeof(integer));
  1012.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1013.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1014.     e_wsfe();
  1015. /* ...  br */
  1016. /*<   440 sens=-vabc*cbc/br/br >*/
  1017. L440:
  1018.     sens = -vabc * cbc / br / br;
  1019. /*<       sensn=br*sens/100.0d0 >*/
  1020.     sensn = br * sens / 100.;
  1021. /*<       write (iofile,101) alsbr,br,sens,sensn >*/
  1022.     io__108.ciunit = status_1.iofile;
  1023.     s_wsfe(&io__108);
  1024.     do_fio(&c__1, (char *)&alsbr, (ftnlen)sizeof(doublereal));
  1025.     do_fio(&c__1, (char *)&br, (ftnlen)sizeof(doublereal));
  1026.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1027.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1028.     e_wsfe();
  1029. /* ...  isc */
  1030. /*<       if (isc.ne.0.0d0) go to 450 >*/
  1031.     if ((doublereal) isc != 0.) {
  1032.         goto L450;
  1033.     }
  1034. /*<       write (iofile,186) alsisc >*/
  1035.     io__109.ciunit = status_1.iofile;
  1036.     s_wsfe(&io__109);
  1037.     do_fio(&c__1, (char *)&alsisc, (ftnlen)sizeof(doublereal));
  1038.     e_wsfe();
  1039. /*<       go to 460 >*/
  1040.     goto L460;
  1041. /*<   450 sens=vabc*cbcn/isc >*/
  1042. L450:
  1043.     sens = vabc * cbcn / isc;
  1044. /*<       sensn=isc*sens/100.0d0 >*/
  1045.     sensn = isc * sens / 100.;
  1046. /*<       write (iofile,101) alsisc,isc,sens,sensn >*/
  1047.     io__110.ciunit = status_1.iofile;
  1048.     s_wsfe(&io__110);
  1049.     do_fio(&c__1, (char *)&alsisc, (ftnlen)sizeof(doublereal));
  1050.     do_fio(&c__1, (char *)&isc, (ftnlen)sizeof(integer));
  1051.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1052.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1053.     e_wsfe();
  1054. /* ...  is */
  1055. /*<   460 sens=(vabe*(cbe/bf)+vabc*(cbc/br) >*/
  1056. /*<      1   +vace*(dqb*qb-dq2*q2))/csat >*/
  1057. L460:
  1058.     sens = (vabe * (cbe / bf) + vabc * (cbc / br) + vace * (dqb * qb - 
  1059.         dq2 * q2)) / csat;
  1060. /*<       sensn=csat*sens/100.0d0 >*/
  1061.     sensn = csat * sens / 100.;
  1062. /*<       write (iofile,101) alsjs,csat,sens,sensn >*/
  1063.     io__111.ciunit = status_1.iofile;
  1064.     s_wsfe(&io__111);
  1065.     do_fio(&c__1, (char *)&alsjs, (ftnlen)sizeof(doublereal));
  1066.     do_fio(&c__1, (char *)&csat, (ftnlen)sizeof(doublereal));
  1067.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1068.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1069.     e_wsfe();
  1070. /* ...  ne */
  1071. /*<       sens=-vabe*gben*vbe/xne >*/
  1072.     sens = -vabe * gben * vbe / xne;
  1073. /*<       sensn=xne*sens/100.0d0 >*/
  1074.     sensn = xne * sens / 100.;
  1075. /*<       write (iofile,101) alsne,xne,sens,sensn >*/
  1076.     io__112.ciunit = status_1.iofile;
  1077.     s_wsfe(&io__112);
  1078.     do_fio(&c__1, (char *)&alsne, (ftnlen)sizeof(doublereal));
  1079.     do_fio(&c__1, (char *)&xne, (ftnlen)sizeof(doublereal));
  1080.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1081.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1082.     e_wsfe();
  1083. /* ...  nc */
  1084. /*<       sens=-vabc*gbcn*vbc/xnc >*/
  1085.     sens = -vabc * gbcn * vbc / xnc;
  1086. /*<       sensn=xnc*sens/100.0d0 >*/
  1087.     sensn = xnc * sens / 100.;
  1088. /*<       write (iofile,101) alsnc,xnc,sens,sensn >*/
  1089.     io__113.ciunit = status_1.iofile;
  1090.     s_wsfe(&io__113);
  1091.     do_fio(&c__1, (char *)&alsnc, (ftnlen)sizeof(doublereal));
  1092.     do_fio(&c__1, (char *)&xnc, (ftnlen)sizeof(doublereal));
  1093.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1094.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1095.     e_wsfe();
  1096. /* ...  ik */
  1097. /*<       if (oik.ne.0.0d0) go to 470 >*/
  1098.     if (oik != 0.) {
  1099.         goto L470;
  1100.     }
  1101. /*<       write (iofile,186) alsik >*/
  1102.     io__114.ciunit = status_1.iofile;
  1103.     s_wsfe(&io__114);
  1104.     do_fio(&c__1, (char *)&alsik, (ftnlen)sizeof(doublereal));
  1105.     e_wsfe();
  1106. /*<       go to 480 >*/
  1107.     goto L480;
  1108. /*<   470 val=1.0d0/oik >*/
  1109. L470:
  1110.     val = 1. / oik;
  1111. /*<       sens=vace*dq2*cbe/(val*val) >*/
  1112.     sens = vace * dq2 * cbe / (val * val);
  1113. /*<       sensn=val*sens/100.0d0 >*/
  1114.     sensn = val * sens / 100.;
  1115. /*<       write (iofile,101) alsik,val,sens,sensn >*/
  1116.     io__115.ciunit = status_1.iofile;
  1117.     s_wsfe(&io__115);
  1118.     do_fio(&c__1, (char *)&alsik, (ftnlen)sizeof(doublereal));
  1119.     do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal));
  1120.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1121.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1122.     e_wsfe();
  1123. /* ...  ikr */
  1124. /*<   480 if (oikr.ne.0.0d0) go to 490 >*/
  1125. L480:
  1126.     if (oikr != 0.) {
  1127.         goto L490;
  1128.     }
  1129. /*<       write (iofile,186) alsikr >*/
  1130.     io__116.ciunit = status_1.iofile;
  1131.     s_wsfe(&io__116);
  1132.     do_fio(&c__1, (char *)&alsikr, (ftnlen)sizeof(doublereal));
  1133.     e_wsfe();
  1134. /*<       go to 500 >*/
  1135.     goto L500;
  1136. /*<   490 val=1.0d0/oikr >*/
  1137. L490:
  1138.     val = 1. / oikr;
  1139. /*<       sens=vace*dq2*cbc/(val*val) >*/
  1140.     sens = vace * dq2 * cbc / (val * val);
  1141. /*<       sensn=val*sens/100.0d0 >*/
  1142.     sensn = val * sens / 100.;
  1143. /*<       write (iofile,101) alsikr,val,sens,sensn >*/
  1144.     io__117.ciunit = status_1.iofile;
  1145.     s_wsfe(&io__117);
  1146.     do_fio(&c__1, (char *)&alsikr, (ftnlen)sizeof(doublereal));
  1147.     do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal));
  1148.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1149.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1150.     e_wsfe();
  1151. /* ...  va */
  1152. /*<   500 if (ova.ne.0.0d0) go to 510 >*/
  1153. L500:
  1154.     if (ova != 0.) {
  1155.         goto L510;
  1156.     }
  1157. /*<       write (iofile,186) alsva >*/
  1158.     io__118.ciunit = status_1.iofile;
  1159.     s_wsfe(&io__118);
  1160.     do_fio(&c__1, (char *)&alsva, (ftnlen)sizeof(doublereal));
  1161.     e_wsfe();
  1162. /*<       go to 520 >*/
  1163.     goto L520;
  1164. /*<   510 va=1.0d0/ova >*/
  1165. L510:
  1166.     va = 1. / ova;
  1167. /*<       sens=vace*q1*q1*dq1*vbc/(va*va) >*/
  1168.     sens = vace * q1 * q1 * dq1 * vbc / (va * va);
  1169. /*<       sensn=va*sens/100.0d0 >*/
  1170.     sensn = va * sens / 100.;
  1171. /*<       write (iofile,101) alsva,va,sens,sensn >*/
  1172.     io__120.ciunit = status_1.iofile;
  1173.     s_wsfe(&io__120);
  1174.     do_fio(&c__1, (char *)&alsva, (ftnlen)sizeof(doublereal));
  1175.     do_fio(&c__1, (char *)&va, (ftnlen)sizeof(doublereal));
  1176.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1177.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1178.     e_wsfe();
  1179. /* ...  vb */
  1180. /*<   520 if (ovb.ne.0.0d0) go to 530 >*/
  1181. L520:
  1182.     if (ovb != 0.) {
  1183.         goto L530;
  1184.     }
  1185. /*<       write (iofile,186) alsvb >*/
  1186.     io__121.ciunit = status_1.iofile;
  1187.     s_wsfe(&io__121);
  1188.     do_fio(&c__1, (char *)&alsvb, (ftnlen)sizeof(doublereal));
  1189.     e_wsfe();
  1190. /*<       go to 540 >*/
  1191.     goto L540;
  1192. /*<   530 vb=1.0d0/ovb >*/
  1193. L530:
  1194.     vb = 1. / ovb;
  1195. /*<       sens=vace*q1*q1*dq1*vbe/(vb*vb) >*/
  1196.     sens = vace * q1 * q1 * dq1 * vbe / (vb * vb);
  1197. /*<       sensn=vb*sens/100.0d0 >*/
  1198.     sensn = vb * sens / 100.;
  1199. /*<       write (iofile,101) alsvb,vb,sens,sensn >*/
  1200.     io__124.ciunit = status_1.iofile;
  1201.     s_wsfe(&io__124);
  1202.     do_fio(&c__1, (char *)&alsvb, (ftnlen)sizeof(doublereal));
  1203.     do_fio(&c__1, (char *)&vb, (ftnlen)sizeof(doublereal));
  1204.     do_fio(&c__1, (char *)&sens, (ftnlen)sizeof(doublereal));
  1205.     do_fio(&c__1, (char *)&sensn, (ftnlen)sizeof(doublereal));
  1206.     e_wsfe();
  1207.  
  1208.  
  1209. /*<   540 loc=nodplc(loc) >*/
  1210. L540:
  1211.     loc = nodplc[loc - 1];
  1212. /*<       go to 220 >*/
  1213.     goto L220;
  1214.  
  1215. /*  finished */
  1216.  
  1217. /*<  1000 continue >*/
  1218. L1000:
  1219.     ;}
  1220. /*<       return >*/
  1221.     return 0;
  1222. /*<       end >*/
  1223. } /* sencal_ */
  1224.  
  1225. #undef cvalue
  1226. #undef nodplc
  1227. #undef alsbf
  1228. #undef alsre
  1229. #undef alsrc
  1230. #undef alsrb
  1231. #undef alsn
  1232. #undef alsis
  1233. #undef alsrs
  1234. #undef ablnk
  1235. #undef sentit
  1236. #undef alsjs
  1237. #undef alsva
  1238. #undef alsikr
  1239. #undef alsik
  1240. #undef alsnc
  1241. #undef alsne
  1242. #undef alsisc
  1243. #undef alsbr
  1244. #undef alsise
  1245.  
  1246.  
  1247.